Just Call Me Internet

home *** CD-ROM | disk | FTP | other *** search

/ Just Call Me Internet / Just Call Me Internet.iso / com / computer / casio_st / prog_fx / volumes / fxvol2.asc < prev next >

Wrap

Text File | 1994-03-01 | 28.7 KB | 1,190 lines

VOLUME 2 *** PROGRAMMES CASIO FX 850P *** (c) W-Tel RTC (16) 62 93 74 05 VOUS VENEZ DE TELECHARGER LE FICHIER FXVOL2.LST SUR W-TEL. CES PROGRAMMES SONT FACILEMENT ADAPTABLES SUR D'AUTRES MICRO. VOUS POUVEZ SOIT RE-TAPER CES PRG SUR VOTRE MICRO, SOIT A L'AIDE DU LOGICIEL TRANSFILE ST850 LES CHARGER DIRECTEMENT SUR LE CASIO FX850P. CE LOGICIEL EST DISTRIBUE PAR OMIKRON FRANCE AU PRIX DE 500FRS ENVIRON. SI VOUS AVEZ ECRIT UN SOFT SUR CASIO FX850P VENEZ LE METTRE SUR W-TEL 24/24 AU 62.93.74.05 (BAL WILLY). SOMMAIRE DU VOLUME 2 Course de chevaux Gestion de compte avec le MEMO Traceur de Courbes sur Casio Fx850p enfin disponible Programme EPHEMERIDES. Redfinir les caractres de votre CASIO. Encore un programme de fraction.... Multiplication de deux polynomes Jour de Paques Roulette magique Mthode d'ordonnancement Johnson et Proust Division Euclidienne Listeur de programme TI57 Calendrier perptuel (c) NEIBAF Suite dans Volume 4... ************************** Course de chevaux Vous pouvez jouer plusieur et parier comme des malades sur les quatres chevaux A, B, C et D. 10 REM COURSE DE CHEVAUX 20 CLEAR :DIM A(3,4) 30 R=1:$="ABCD" 40 PRINT "-------<COURSE DE CHEVAUX>-- ----"; 50 FOR J=1 TO 5:BEEP:BEEP1:NEXT J 60 PRINT 70 PRINT" CHEVAL "; 80 PRINT " ";:FOR J=1 TO 4:PRINT " ";MID$(J,1);:NEXT J 90 GOSUB 1000:GOSUB 1000:GOSUB 1000 100 PRINT :BEEP 105 CLS 110 INPUT " COMBIEN DE JOUEURS ?: ",P 120 IF P>5 THEN 110 130 IF P<1 THEN 110 135 CLS 140 PRINT " TOUT LES JOUEURS ONT 20 F"; 150 GOSUB 1000:GOSUB 1000 160 DIM X(2,P),Y$(P) 170 FOR J=1 TO P:X(2,J)=20:NEXT J 180 REM INITIALISATION 190 G=0 200 FOR J=1 TO 4 210 A(1,J)=0:A(2,J)=RAN#:A(3,J)=1+INT(10^ (1.2-A(2,J))) 220 NEXT J 225 CLS 230 PRINT :PRINT " ********<COURSE ";R;">********** ******************************";:GOSUB 1000:GOSUB 1000 240 REM ARGENT DU PARI 250 FOR J=1 TO P 260 PRINT :X(1,J)=0:Y$(J)="" 270 IF X(2,J)=0 THEN 450 280 CLS:PRINT " JOUEUR";J;"A";X(2,J);"F"; 290 GOSUB 1000:GOSUB 1000:GOSUB 1000 295 CLS 300 LOCATE 1,1:PRINT "CHEVAL"; 305 FOR K=1 TO 4 310 LOCATE K*6+4,1:PRINT MID$(K,1); 312 NEXT K 315 LOCATE 1,2:PRINT"COTE"; 320 FOR K=1 TO 4 325 LOCATE K*6+3,2:PRINT A(3,K); 330 NEXT K 340 GOSUB 1000:BEEP 350 REM PRINT CSR0 360 A$=KEY$:IF A$="" THEN 360 370 IF A$="A"THEN 400 375 IF A$="B"THEN 400 380 IF A$="C"THEN 400 385 IF A$="D"THEN 400 387 GOTO 360 400 Y$(J)=A$ 410 BEEP:PRINT :PRINT "LE JOUEUR";J;" JOUE LE CHEVAL ";A$; 420 INPUT " ARGENT EN JEU ?:",X(1,J) 430 IF X(2,J)<X(1,J) THEN 410 440 X(2,J)=X(2,J)-X(1,J) 450 NEXT J 460 PRINT 470 PRINT "<FEU!>"; 480 FOR K=1 TO 10:BEEP:NEXT K 490 PRINT 500 REM JEU 510 IF G=2 THEN 600 520 FOR J=1 TO 4 530 IF G>=1 THEN 560 540 PRINT CSRA(1,J);" "; 550 IF RAN#*(0.9+A(2,J)/10)>0.7 THEN A(1,J)=A(1,J)+1 560 IF A(1,J)=31 THEN G=G+1 570 PRINT CSRA(1,J);MID$(J,1); 580 NEXT J 590 GOTO 500 600 REM BUT 610 PRINT CSR0;"BUT!"; 620 FOR J=1 TO 7:BEEP:BEEP1:NEXT J 630 GOSUB 1000 640 FOR J=1 TO 4 650 IF A(1,J)=23 THEN H=A(3,J):A$=MID$(J,1) 660 NEXT J 670 F=0 680 FOR J=1 TO P 690 M=0:IF X(1,J)=0 THEN 730 700 IF Y$(J)=A$ THEN M=X(1,J)*H 710 PRINT :BEEP 720 PRINT "JOUEUR";J;"->PRIX";M;"F"; 730 X(2,J)=X(2,J)+M:GOSUB 1000 740 PRINT :BEEP:IF X(2,J)=0 THEN F=F+1 750 PRINT "JOUEUR";J;"A";X(2,J);"F";:GOSUB 1000 760 NEXT J 770 PRINT :BEEP:IF F=P THEN 830 780 PRINT "REJOUE-TU[O/N]?"; 790 A$=KEY$:IF A$="" THEN 790 800 IF A$="O" THEN R=R+1:GOTO 180 810 IF A$="N" THEN 830 820 GOTO 790 830 PRINT :PRINT "************GAME OVER***********" 840 END 1000 REM COMPTEUR 1010 FOR K=1 TO 200:NEXT K 1020 RETURN ************************** Gestion de compte avec le MEMO Mettez la fin de votre MEMO: MODE 9 BANQ (EXE) 01/01/90,libelle,0,1000 (EXE) % (EXE) Sachant que BANQ est le pointeur du dbut du fichier et % celui de la fin. La syntaxe est pour les oprations: DATE$,LIBELLE$,DEBIT$,CREDIT$ Les virgules sont importantes ! Ne rien mettre la fin de votre MEMO, sinon c'est perdu ! 1 REM MEMO: BANQ 2 REM 01/01/90,LIBELLE,DEBIT,CREDIT 3 REM % (FIN FICHIER) 4 REM (c) W-Tel 62 93 74 05 5 REM Ralis par Willy 10 RESTORE#:RESTORE# "BANQ":READ# A$ 20 SOLDE=0 30 READ# DATE$:IF DATE$="%" THEN 50 40 READ# L$,D$,C$:SOLDE=SOLDE- VAL(D$)+VAL(C$):GOTO 30 50 CLS:PRINT "SOLDE:";SOLDE;CHR$(13); 60 INPUT "DATE (JJ/MM/AA):",DATE$:LOCATE 0,0:LOCATE 0,1:PRINT " ";:LOCATE 0,0:LOCATE 0,1 70 INPUT "LIBELLE:",L$:LOCATE 0,0:LOCATE 0,1:PRINT " ";:LOCATE 0,0:LOCATE 0,1 80 INPUT "SOMME:",S:LOCATE 0,0:LOCATE 0,1:PRINT " ";:LOCATE 0,0:LOCATE 0,1 90 INPUT "Debit/Credit:",A$:LOCATE 0,0:LOCATE 0,1:PRINT " ";:LOCATE 0,0:LOCATE 0,1 95 IF A$<>"C" AND A$<>"D" THEN 90 100 IF A$="D" THEN D$=STR$(S):C$="" 110 IF A$="C" THEN C$=STR$(S):D$="" 120 CLS:PRINT DATE$","L$;CHR$(13)"Debit:"D$",Credit:"C$:INPUT "OK? (O/N):";A$:IF A$="N" THEN GOTO 50 130 RESTORE#:RESTORE# "%":WRITE# "%,,," 140 RESTORE#:RESTORE# "%,,,":WRITE# DATE$,L$,D$,C$:WRITE# "%":GOTO 10 ************************** Traceur de Courbes sur Casio Fx850p enfin disponible Exemple: F(x)= ? SINx +EXE 1/2xmin= -4 +EXE 1/2xmax= 4 +EXE ymin= -4 +EXE ymax= 4 +EXE Dfinition= 1 +EXE (nbre de caractres sparant 2 points, 1 est le plus prcis) Graduation= 2 +EXE (0: pas de graduation, 1:graduation avant, 2: graduation aprs) % Erreur= 0.1 +EXE (prcision de graduation, mettre toujours 0.1 ?!?) Merci PIELB pour avoir chercher ce petit programme. Qui en est l'auteur ? ALAIN ? 1 ON ERROR GOTO 100 5 CLS:DEFCHR$(255)="0000FF0000":DEFCHR$ (253)="0000100000":DEFCHR$(252)="0000 800000":DEFCHR$(254)="0000020000" 10 PRINT CHR$(15);CALC$;" ?";:INPUT@(190);Z$:IF Z$<>"" THEN A$=Z$ 11 CALC$="F(x)="+A$:CLS:PRINT CSR7;"...Function RANGE...";:LOCATE 0,1 20 INPUT "1/2 x min:",x1:xmin=x1*2:INPUT "1/2 x max:",x2:xmax=x2*2:INPUT "y min:",ymin,"y max:",ymax,"definition:",p:H=xmax- xmin:V=ymax-ymin:INPUT "graduation:",G:IF G<>0 THEN INPUT "% error:",t 40 CLS:X0=-xmin*32/H:Y0=INT(ymax*7/V) +.5:FOR Y=0 TO 7:LOCATE X0,Y:PRINT CHR$(255);:NEXT Y:FOR X=0 TO 30:LOCATE X,Y0:PRINT "-";:NEXT :LOCATE X0,Y0:PRINT "+";:IF Y0<7 AND X0<31 THEN LOCATE 31,Y0:PRINT "-"; 45 IF G=1 THEN GOSUB 1000 50 FOR l=0 TO 31 STEP p:x=(l- X0)*(H/32):h=Y0-VALF(A$)*8/V 51 q=FRACh:a$=CHR$(253) 52 IF q<.4 THEN a$=CHR$(252) 53 IF q>.6 THEN a$=CHR$(254) 59 IF h=7 AND l=31 THEN 61 60 IF h>=0 AND h<8 THEN LOCATE l,h:PRINT a$; 61 NEXT :LOCATE X0,Y0:IF G=2 THEN GOSUB 1000 62 STOP:GOTO 1 91 NEXT :LOCATE X0,Y0:IF G=2 THEN GOSUB 1000 100 IF ERR=2 THEN 1 ELSE RESUME NEXT 1000 FOR l=0 TO 31:x=(l-X0)*(H/32):IF l<32 AND x<10 AND x>=0 AND (FRACx)<=t THEN LOCATE l,Y0:PRINT CHR$(144+x); 1001 NEXT :Y1=Y0:Y0=INTY0:FOR h=0 TO 7:y=(Y0-h)*(V/8):IF FRACy<=t AND y=>0 AND y<10 THEN LOCATE X0,h:PRINT CHR$(144+y); 1010 NEXT :Y0=Y1:RETURN ************************** Programme EPHEMERIDES. L'astronomie vous passionne ? Alors pour connaitre la position des astres afin de pointer vos jumelles (mais si ! On peut apercevoir ainsi les satellites de Jupiter), ou votre tlescope vers l'infiniment loign, tapez ce programme (plus de 3696 octets pour le programme et 1249 octets pour les variables !). A la mise en route, le programme demande la date sous la forme JJ.MM.AAAA. Puis l'heure en temps universel, introduite sous la mme forme en heure, minutes et secondes. L'heure en T.U. s'obtient, en France, en retranchant de l'heure lgale, une heure en hivers et deux heures en t. Le Casio calcule et affiche alors: - N le nombre de jours couls depuis le 1er Janvier 1901 et le jour de la semaine. - La longitude du soleil, donne indispensable pour la suite du calcul, les coordonnes cartsiennes sont galement calcules, mais non affiches. Le programme demande alors l'introduction des deux premires lettres de la plante dont on dsire les coordonnes et il calcule et affiche la longitude et la latitude de la plante. On peut alors: - soit demander une autre position pour le mme jour et la mme heure, - soit introduire: EQ le programme donne alors les coordones quatoriales de la plante (ou du soleil au dbut) dont les coordonnes sont affiches, TS le programme demande la longitude du lieu et donne le temps sidral local pour le jour et l'heure entrs au dbut, ST provoque un arrt du programme. Notes techniques: 1- prcision d'environ de 1/10 de degr pour le soleil et les plantes sauf Jupiter et Saturne o l'cart peut atteindre 1/2 de degr. 2- pour Jupiter, Saturne, Uranus et Neptune, les constantes sont corriges pour tenir compte des pertubations longue periode pour les dates entre 1900 et 2000. (c) Serge BOUIGES adaptation Willy 1 CLEAR:REM W-Tel 62 93 74 05 EPHEMERIDES 2 DIM Z$(6),LO(7),LP(7),PO(7),PP(7),OO(7) ,OP(7),E(7),I(7),A(7):MODE 5 10 PRINT "EPHEMERIDES";CHR$(13);:INPUT "DATE(JJ.MM.AAAA)";J$:J=VAL(MID$(J$, 1,2)):M=VAL(MID$(J$,4,2)):A=VAL(MID$( J$,7,4)) 20 INPUT "HEURE TU (HH.MM.SS)";H$:H=VAL(MID$(H$,1,2)): T=VAL(MID$(H$,3,2)):S=VAL(MID$(H$,5,2)) 50 HS=H/24+T/1440+S/86400:J=J+HS 60 N=A*365+31*(M-1)+J:IF M>2 GOTO 90 80 A=A-1 90 N=N+INT(A/4)-INT(A/100)+INT(A/400) 100 IF M<=2 GOTO 120 110 N=N-INT((M-1)*.4+2.7) 120 N=N-694325 130 PRINT "N="N;CSR(15); 140 DATA LUNDI,MARDI,MERCREDI,JEUDI,VENDREDI ,SAMEDI,DIMANCHE 145 FOR I=0 TO 6:READ Z$(I):NEXT 150 I=INT((N/7-INT(N/7))*7+.005) 160 PRINT Z$(I) 180 DATA 4.8689,1.72027914E- 2,4.9085,8.1856E- 7,.01675104,1.00000023,3 190 READ LO,LP,PO,PP,E,A,KE 200 P=PO+PP*N:M=LO+LP*N-P 210 GOSUB 300 220 V=2*ATN(TAN(U/2)*SQR((1+E)/(1-E))) 230 R=A*(1-E*COS(U)):L=V+P 240 XS=R*COS(L):YS=R*SIN(L) 250 GOSUB 340 260 PRINT "LONG SOLEIL="DMS$(LD) 270 GOTO 380 300 Q=INT(M/2/PI):M=M-2*Q*PI:U=M 310 FOR K=0 TO KE 320 U=M+E*SIN(U):NEXT :RETURN 340 LD=L*180/PI 350 LD=(LD/360-INT(LD/360))*360 360 IF LD<0 THEN LD=LD+360 370 LD=INT(LD*10+.5)/10:RETURN 380 DATA 4.0117,7.14254534E- 2,1.3249,7.4229E-7,.82304,5.6618E- 7,.205615,.1222,.387098 390 DATA 3.6086,2.79631195E- 2,2.2716,6.5572E-7,1.3229,4.366E- 7,.006816,.05923,.7273 400 DATA 2.1776,9.14676584E- 3,5.8338,8.793E-7,.8516,3.712E- 7,.093309,3.2294E-2,1.523678 410 DATA 4.6879,1.4509868E- 3,.2289,857E-9,1.7358,483E- 9,.048376,.02284,5.202799 420 DATA 4.8567,5.8484028E- 4,1.5974,412E-9,1.9686,417E- 9,.054311,435E-4,9.552098 430 DATA 4.3224,205424E-9,2.9523,762E- 9,1.2825,2.3824E-7,.047319,1.3482E- 2,19.21694 440 DATA 1.5223,105061E-9,.7637,393E- 9,2.281,525E-9,.008262,3.1054E- 2,30.112912 450 DATA 1.6406,701214E- 10,3.8978,6.672E-7,1.9034,6.672E- 7,.250236,.29968,39.438712 460 FOR J=0 TO 7 470 READ LO(J),LP(J),PO(J),PP(J),OO(J),OP(J) ,E(J),I(J),A(J):NEXT 500 CLS:PRINT "ME,VE,MA,JU,SA,UR,NE,PL,TS,ST,EQ"; :INPUT "PLANETE(.) :",P$ 505 IF P$="." GOTO 2000 510 IF P$="ME" GOTO 650 520 IF P$="VE" GOTO 660 530 IF P$="MA" GOTO 670 540 IF P$="JU" GOTO 680 550 IF P$="SA" GOTO 690 560 IF P$="UR" GOTO 700 570 IF P$="NE" GOTO 710 580 IF P$="PL" GOTO 720 590 IF P$="TS" GOTO 900 600 IF P$="ST" THEN END 610 IF P$="EQ" GOTO 1010 620 GOTO 500 650 T$="MERCURE":J=0:KE=5:GOTO 730 660 T$="VENUS":J=1:KE=3:GOTO 730 670 T$="MARS":J=2:KE=5:GOTO 730 680 T$="JUPITER":J=3:KE=4:GOTO 730 690 T$="SATURNE":J=4:KE=4:GOTO 730 700 T$="URANUS":J=5:KE=4:GOTO 730 710 T$="NEPTUNE":J=6:KE=3:GOTO 730 720 T$="PLUTON":J=7:KE=7:GOTO 730 730 P=PO(J)+PP(J)*N:M=LO(J)+LP(J)*N-P 740 E=E(J):GOSUB 300 750 V=2*ATN(TAN(U/2)*SQR((1+E)/(1-E))) 760 O=OO(J)+OP(J)*N:C=V+P-O 770 IF COS(C)=0 THEN D=C:GOTO 800 780 D=ATN(TAN(C)*COS(I(J))) 790 IF COS(C)<0 THEN D=D+PI 800 LS=D+O 810 BS=ATN(SIN(D)*TAN(I(J))) 820 RS=A(J)*(1-E*COS(U)) 830 XP=RS*COS(BS)*COS(LS)+XS:YP=RS*COS (BS)*SIN(LS)+YS:ZP=RS*SIN(BS) 840 R=SQR(XP^2+YP^2):B=ATN(ZP/R): L=ATN(YP/XP) 850 IF XP<0 THEN L=L+PI 870 GOSUB 340 880 PRINT "LONGITUDE "T$"="DMS$(LD);CHR$(13);:PRINT "LATITUDE="DMS$(INT(B*18000/PI+.5)/100) 890 GOTO 500 900 INPUT "LONG LIEU EN DEG DECIMAUX, (-) A L'EST DE GREENWICH:";LO 920 RD=1.7273+1.72027914E-2*N+HS*2*PI- LO*PI/180 930 GOSUB 955 940 PRINT "TEMPS SIDERAL="H"h"M"m"S"s" 950 GOTO 500 955 RD=(RD/2/PI-INT(RD/2/PI))*2*PI 960 H=INT(RD/PI*12) 970 M=INT((RD-H*PI/12)*720/PI) 980 S=INT((RD-H*PI/12- M*PI/720)*43200/PI) 990 RETURN 1010 EP=.40927971 1020 SD=COS(EP)*SIN(B)+SIN(EP)*COS(B) *SIN(L) 1030 DE=ATN(SD/SQR(1-SD^2)) 1040 SR=COS(EP)*COS(B)*SIN(L)- SIN(EP)*SIN(B) 1050 RD=ATN(SR/COS(B)/COS(L)) 1060 IF COS(L)*COS(B)<0 THEN RD=RD+PI 1070 IF RD<0 THEN RD=RD+PI*2 1080 GOSUB 955 1090 PRINT "ASCENS. DROITE="H"h"M"m"S"s";CHR$(13); 1100 PRINT "DECLINAISON="DMS$(INT(DE*18000/PI+ .5)/100) 1200 GOTO 500 2000 CLS:PRINT "ME:MERCURE, VE:VENUS, MA:MARS, JU:JUPITER, SA:SATURNE":CLS:PRINT "UR:URANUS, NE:NEPTUNE, PL:PLUTON":CLS:PRINT "TS:TEMPS SIDERAL LOCAL, EQ:COORDONNEES EQUATORIALES":CLS:PRINT "ST:FIN DU PROGRAMME, .:MENU AIDE":GOTO 500 ************************** Redfinir les caractres de votre CASIO. 1 REM ACCENTS 2 REM par PIELB 3 REM distribue par W-TEL 4 REM (16) 62 93 74 05 24h/24 5 REM BANQUE DE DONNEES CASIO 10 PRINT "Creation de nouveaux caracteres:"; 20 J=10:U=1:FOR I=252 TO 255:$="052BAB6B1F056BAB6B1F01A33F83 0101539F4301":DEFCHR$(I)=MID$(U,J): U=U+10:PRINT I;":";CHR$(I);:NEXT:PRINT " ":CLS 30 J=10:U=1:FOR I=252 TO 255:$="1D6BAB2B191DAB6B2B191D6BAB6B 191D4383451F":DEFCHR$(I)=MID$(U,J): U=U+10:PRINT I;":";CHR$(I);:NEXT:PRINT " " ************************** Encore un programme de fraction.... Pas trs rapide mais en une ligne ! 1 REM UN AUTRE PROGRAMME DE FRACTION 2 REM DISTRIBUE PAR W-TEL 10 CLEAR :Q=1:R=1:INPUT "N:",N:X=N:FOR G=1 TO 50:A=INTN:N=N- A:T=P+A*Q:P=Q:Q=T:T=R+A*S:R=S:S=T:IF ABS(X-Q/S)=>1E-12;N=1/N:NEXT ELSE PRINT Q"/"S"="Q/S:GOTO 10 ************************** Multiplication de deux polynomes Multiplie P(x) et Q(x), le rsultat est C(x). Le programme vous demande les coef de chaque polynome, et vous donne les coef du polynome C(x). 1 REM PRODUIT DE 2 POLYNOMES 2 REM DISTRIBUE PAR W-TEL 3 REM (16) 62 93 74 05 24h/24 4 REM Serveur dedie aux CASIO 5 REM Banque de donnees ouverte a tous. 10 CLEAR :DIM A(10),B(10),C(10):INPUT "DEG P(x):",N:FOR I=N TO 0 STEP - 1:PRINT "P^"I;:INPUT A(I):NEXT I:INPUT "DEG Q(x):",M:FOR I=M TO 0 STEP - 1:PRINT "Q^"I;:INPUT B(I):NEXT I:FOR L=0 TO M+N:X=(L+N-ABS(L-N))/2:FOR I=0 TO X:J=L-I:C(L)=C(L)+A(I)*B(J) 20 NEXT I:NEXT L:FOR L=M+N TO 0 STEP- 1:PRINT "C^"L"="C(L):NEXT L:END ************************** Jour de Paques Ce programme vous donne tout simplement le jour de Paques de l'anne choisie. 1 REM JOUR DE PAQUES 2 REM DISTRIBUE PAR W-TEL 3 REM (16) 62 93 74 05 24h/24 4 REM BANQUE DE DONNEES 5 REM SUR SERVEUR MINITEL 10 INPUT "ANNEE:",J:IF J<1582 OR J>2200 THEN 10 20 X=INT(J/100):ON 22-X GOTO 30,40,40,50,60,70,70 30 M=24:N=6:GOTO 80 40 M=24:N=5:GOTO 80 50 M=23:N=4:GOTO 80 60 M=23:N=3:GOTO 80 70 M=22:N=2 80 A=J-INT(J/19)*19:B=J- INT(J/4)*4:C=J- INT(J/7)*7:D=19*A+M:D=D- INT(D/30)*30:E=2*B+4*C+6*D+N:E=E- INT(E/7)*7:F=22+D+E:G=D+E-9:IF F>31 THEN 100 90 PRINT "DIMANCHE DE PAQUES"J" EST LE"F"MARS":GOTO 140 100 IF G<25 THEN 130 110 IF G=26 THEN G=19:GOTO 130 120 IF D=28 AND A>10 THEN G=18 130 PRINT "DIMANCHE DE PAQUES"J" EST LE"G"AVRIL" 140 CLS:GOTO 10 ************************** Roulette magique Vous voulez jouer la roue de la fortune ? Alors tapez ce petit programme... 1 REM ROULETTE 2 REM par PIELB 3 REM distribue par W-TEL 4 REM (16) 62 93 74 05 5 REM BANQUE DE DONNEES CASIO 10 CLEAR :A=INT(3*(RAN#*36)):IF FRAC(A/3)>0 THEN 10 ELSE CLS:N$="00/01/02/03/04/05/06/07/08/ 09/10/11/12/13/14/15/16/17/18/19/20 /21/22/23/24/25/26/27/28/29/30/3 1/32/33/34/35/36/":X=-500:LOCATE 15,1:PRINT CHR$(227);:N$=N$+N$ 20 X=X+20:FOR I=0 TO X:NEXT :IF X=300 THEN BEEP1:STOP:GOTO 10 ELSE LOCATE 5,0:PRINT MID$(N$,A,22);:N$=RIGHT$(N$,LEN(N$)- 3)+LEFT$(N$,3):GOTO 20 ************************** Mthode d'ordonnancement Johnson et Proust Ce programme permet d'ordonnancer un atelier mais dans un type de problme bien spcifique: Passage de toutes les pices sur toutes les machines mais surtout dans un seul sens (pas de retour). Ce type de problme est facilement rsolu par les mthodes de Johnson et Proust. Pour ton renseignement sur ces mthodes crivez SAINT-CRICQ William, 98 avenue du Rgiment de Bigorre, 65000 TARBES, et demandez le cours sur les mthodes d'ordonnencement. Tapez ce programme en partout sauf en P1: 1 CLS:CLEAR :A$="J":INPUT "P";N$:P$="P"+N$ 5 RESTORE# P$:READ# t$:ERASE N$ 10 READ# I,J:DIM T(I,J-1),M(I,J- 1),D(I,J-1) 20 FOR U=1 TO I 30 FOR V=0 TO J-1 40 READ# T(U,V) 50 NEXT V:NEXT U 55 CLS:PRINT "Johnson ou Proust ?";:A$=INPUT$(1):IF A$<>"P" THEN IF A$<>"J" THEN 55 ELSE CLS 60 IF A$="P" THEN RESTORE#"M" ELSE GOTO #1 65 READ# t$ 70 FOR U=1 TO I:FOR V=0 TO J-1 80 READ# M(U,V):NEXT V:NEXT U 85 READ# t$ 90 FOR U=1 TO I:FOR V=0 TO J-1 95 READ# D(U,V):NEXT V:NEXT U 100 GOTO #1 Tapez celui-ci en P1: 5 ERASE O,TT,TP:DIM O(I),TT(I,2),TP(J- 1):POS1=0:POS2=J:CLS 7 FOR NB=1 TO J- 2:POS1=POS1+1:POS2=POS2-1 8 FOR U=1 TO I:TT(U,0)=U:O(U)=0 9 TT(U,1)=T(U,POS1)+TT(U,1):TT(U,2)= T(U,POS2)+TT(U,2) 11 IF A$="P" THEN 12 ELSE 14 12 TT(U,1)=TT(U,1)+M(U,1)- M(U,POS2):TT(U,2)=TT(U,2)+D(U,J-1)- D(U,POS1) 13 IF NB>=2 THEN TT(U,1)=TT(U,1)- M(U,1)+M(U,POS2+1):TT(U,2)=TT(U,2)- D(U,J-1)+D(U,POS1-1) 14 PRINT U;TT(U,1);TT(U,2):NEXT U 15 PRINT "PB";NB;"Ordre:";:CA=0:CB=I+1 20 FOR U=1 TO I 25 A=1E5:B=1E5 30 FOR V=1 TO I 35 IF TT(V,0)>I THEN 80 40 IF TT(V,1)<A THEN A=TT(V,1):TA=TT(V,0) 50 IF TT(V,2)<B THEN B=TT(V,2):TB=TT(V,0) 80 NEXT V 87 IF A>B THEN 88 ELSE CA=CA+1:O(CA)=TA:TT(TA,0)=I+1:GOTO 90 88 CB=CB-1:O(CB)=TB:TT(TB,0)=I+1 90 NEXT U 100 FOR U=1 TO I 110 PRINT O(U); 120 NEXT U:TA=0:TB=TT(O(1),1):PRINT 155 REM CALCUL TEMPS 180 FOR V=1 TO J-1:TP(V)=0:NEXT V 200 FOR V=2 TO J-1 210 TP(V)=TP(V-1)+T(O(1),V- 1)+M(O(1),V-1)+D(O(1),V-1) 220 NEXT V 230 FOR U=1 TO I-1 240 FOR V=1 TO J-1 250 TP(V)=TP(V)+T(O(U),V)+M(O(U),V)+D(O (U),V) 260 NEXT V 270 FOR V=1 TO J-2 275 INE=T(O(U+1),V)+M(O(U+1),V)+D(O(U+ 1),V) 280 IF TP(V+1)<(TP(V)+INE) THEN TP(V+1)=TP(V)+INE 290 NEXT V 300 NEXT U 310 RES=TP(V)+T(O(U),V)+M(O(U),V)+D( O(U),V):PRINT "Temps ";RES 320 NEXT NB Puis tapez dans le MEMO votre problme: P1 (pointeur fichier nø1, mthode Proust) 6,5 (dimension du problme: nombre de tache,nombre de machine+1) 1,50,60,20,50 (nø de tache,temps d'excution sur la machine 1, temps d'excution sur la machine 2,....) 2,90,50,90,50 (idem) 3,70,20,50,70 4,20,50,20,50 5,110,60,15,15 6,30,100,45,120 M (pointeur des temps de montage sur chaque machine) 1,2,3,2,2 (nø de tache,temps de montage sur la machine 1,temps de montage sur la machine 2,....) 2,3,4,1,2 (idem) 3,5,6,6,8 4,2,5,5,6 5,6,3,2,3 6,10,6,3,6 D (pointeur des temps de dmontage sur chaque machine) 1,4,5,1,3 (nø de tache,temps de dmontage sur la machine 1,temps de dmontage sur la machine 2,....) 2,2,2,2,3 (idem) 3,6,1,4,5 4,3,8,3,4 5,5,2,5,2 6,8,4,2,8 P2 (pointeur fichier 2, problme Johnson) 6,3 (6 taches et 2 machines) 1,3,4 (nø tache,temps d'excution) 2,5,4 (ici pas de temps de montage ni de dmontage) 3,8,7 4,2,3 5,6,5 6,6,7 ************************** Division Euclidienne Vous pouvez diviser deux polynomes de degr respectif n et m. Le programme vous donne le rsultat de la division entire et le reste. Ex: 4x^2+3x-4 / 5x-6 DIVISION EUCLIDIENNE Deg N: 2 Deg D: 1 N^2: 4 N^1: 3 N^0: -4 D^1: 5 D^0: -6 rsultat: 0.8 x^1 + 1.56 x^0 + reste: 5.36 10 CLEAR :PRINT "DIVISION EUCLIDIENNE";CHR$(13); 20 INPUT "Deg N:",N,"Deg D:",D 30 DIM A(N),B(D) 40 FOR I=N TO 0 STEP-1:PRINT "N^";I;:INPUT ":",A(I):NEXT I 50 FOR I=D TO 0 STEP -1:PRINT "D^";I;:INPUT ":",B(I):NEXT I 100 FOR I=N-D TO 0 STEP- 1:K=A(D+I)/B(D):PRINT K"x^"I"+"; 110 FOR J=I TO D+I:A(J)=A(J)-K*B(J- I):NEXT J:NEXT I 150 PRINT " ":PRINT "RESTE:";:IF D<2 THEN 200 160 FOR I=D-1 TO 1 STEP -1 170 PRINT A(I)"x^"I"+";:NEXT I 200 PRINT A(0) ************************** Listeur de programmes TI57 Si vous avez le bonheur de possder une TI 57, alors ce programme vous intresse. En effet il permet de sortir sur le MEMO et donc sur imprimante un listing complet de programmes. Il permet aussi d'utiliser votre Fx comme banque de programmes TI57. Entrez dans le MEMO le programme TI sous forme de codes en chiffres. Exemple: P1 # 61.85.00 71.00 42 65 02 -31 95 50 58 61.00 00 23.00 13 61.01 00 51 71.00 61.75.01 71.01 26 33 02 51 71.01 28.01 71.01 50 75 01 00 95 28.01 00 22.00 23.01 50 27 -28 51 22.00 . Avec P1 , pointeur de dbut du programme P1. # , autre pointeur ncessaire ! Et enfin . indiquant la fin du programme P1. Executez le programme principal et visualisez ensuite le MEMO qui devient: P1 #Jeu Cherchez l'Error 2nd Part 2 Nombre de pas: 40 Codes Touches Pas 61.85.00 STO + 0 0 71.00 RCL 0 1 42 sin 2 65 * 3 02 2 4 -31 Inv log 5 95 = 6 50 2nd |x| 7 58 2nd Intg 8 61.00 STO 0 9 00 0 10 23.00 LBL 0 11 13 R/S 12 61.01 STO 1 13 00 0 14 51 x<>t 15 71.00 RCL 0 16 61.75.01 STO - 1 17 71.01 RCL 1 18 26 2nd x=t 19 33 1/x 20 02 2 21 51 x<>t 22 71.01 RCL 1 23 28.01 2nd SBR 1 24 71.01 RCL 1 25 50 2nd |x| 26 75 - 27 01 1 28 00 0 29 95 = 30 28.01 2nd SBR 1 31 00 0 32 22.00 GTO 0 33 23.01 LBL 1 34 50 2nd |x| 35 27 2nd x>=t 36 -28 2nd Inv SBR 37 51 x<>t 38 22.00 GTO 0 39 . Voici le programme principal: (Attention la ligne 25, changer GOSUB #0 par #n avec n l'endroi o vous allez mettre le second programme.) 1 ERASE P$:DIM P$(255):N$="" 2 ON ERROR GOTO 1000 5 CLS:PRINT "- TI 57 V1.00 - (c) Wtel 1990";CHR$(13); 6 PRINT "*:DEL,H:HLP,NoProg,C:CAT:"; :INPUT@(3);N$:IF N$="" THEN GOTO 5 7 IF N$="C" THEN1 ERASE P$:DIM P$(255) :N$="" 2 ON ERROR GOTO 1000 5 CLS:PRINT "- TI 57 V1.00 - (c) Wtel 1990";CHR$(13); 6 PRINT "*:DEL,H:HLP,NoProg,C:CAT:"; :INPUT@(3);N$:IF N$="" THEN GOTO 5 7 IF N$="C" THEN GOSUB 500:GOTO 5 8 IF N$="*" THEN GOSUB 600:GOTO 5 9 IF N$="H" THEN GOSUB 700:GOTO 5 10 RESTORE#:RESTORE# "P"+N$:READ# A$:C=- 1:NE=0 15 READ# A$:IF LEFT$(A$,1)<>"#" THEN PRINT "Le debut du programme doit com- mencer par #.":END 20 C=C+1:READ# L$:L=LEN(L$):IF L>8 THEN L$=LEFT$(L$,8):IF RIGHT$(L$,1) =" " AND LEFT$(L$,1)<>"-" THEN L$=LEFT$(L$,5) ELSE IF RIGHT$ (L$,1)=" " THEN L$=LEFT$(L$,6) 21 IF L>8 THEN IF RIGHT$(L$,1)=" " AND LEFT$(L$,1)<>"-" THEN L$=LEFT$ (L$,2) ELSE IF RIGHT$(L$,1)=" " THEN L$=LEFT$(L$,3) 25 IF L$<>"." THEN GOSUB #0:P$(C)= LEFT$(L$+" ",11)+LEFT$(S$+" ",15)+STR$(C): GOTO 20 27 C=C-1:CLS 30 PRINT "Sauvegarde ds MEMO... Entrez Nom:"; 40 INPUT@(31);$:IF LEN($)>31 THEN "Trop long":GOTO 30 45 IF $="" THEN RESTORE#:RESTORE# "P"+N$:READ# A$,$:$=MID$($,2,31) 47 $="#"+$ 50 RESTORE#:RESTORE# "P"+N$:READ# A$ 51 IF C<48 THEN P=1 52 IF C<40 THEN P=2 53 IF C<32 THEN P=3 54 IF C<24 THEN P=4 55 IF C<16 THEN P=5 56 IF C<08 THEN P=6 57 IF C>47 THEN P=-1 58 IF C=-1 THEN P=7 60 IF P<>0 THEN $=LEFT$($+" ",32)+"2nd Part"+STR$(P) 70 IF P=0 THEN $=LEFT$($+" ",32)+"Attention plus de 47 pas." 80 $=LEFT$($+" ",64)+"Nombre de pas:"+STR$(C+1) 85 $=LEFT$($+" ",96)+" " 90 $=LEFT$($+" ",128)+"Codes Touches Pas" 95 WRITE# $ 100 FOR I=0 TO C:WRITE# P$(I):NEXT I:CLS:GOTO 5 500 REM CATALOGUE PROG 510 RESTORE# 520 RESTORE# "P":READ# A$,B$:PRINT A$;CHR$(13);MID$(B$,2,31):GOTO 520 600 REM EFFACE PROG 605 N$="" 610 CLS:PRINT "No Prog a effacer:"; :INPUT@(3);N$:INPUT "Confirmation (O/N):";C$:IF C$="N" THEN RETURN 620 RESTORE#:RESTORE# "P"+N$:READ# A$,A$ 630 C$=MID$(A$,64+15,3):C=VAL(C$):IF C<0 THEN PRINT "Erreur...":END 640 RESTORE#:RESTORE# "P"+N$ 650 FOR I=-2 TO C:WRITE#:NEXT I 660 PRINT "FINI...":RETURN 700 REM HLP 710 CLS:PRINT "La syntaxe dans le MEMO doit etre la suivante:" 720 PRINT "Pn : n est le num du programme." 730 PRINT "# : pointeur avant programme." 740 PRINT "Puis les codes xx.yy.zz, c.a.d le programme code TI57." 750 PRINT ". : indique la fin du programme" 760 RETURN 1000 RESUME 5 Voici maintenant le second programme, qui sera mis en P0: 10 DATA 13,R/S,15,On/C,21,RST,26,2nd x=t,27,2nd x>=t,29,2nd Dsz,31,log,32 ,lnx,33,1/x,34,x^2,35,x^.5,40,2nd x!, 41,DGR,42,sin,43,cos,44,tan,45,y^x, 46,2nd DRG>,47,2nd P<>R,48,2nd DMS- DD,49,2nd PI,50,2nd |x|,51,x<>t,52,EE, 53,(,54,),55,:,56,2nd Ct,58,2nd Intg 20 DATA 59,2nd Frac,65,*,75,- ,76,2nd CM,85,+,93,.,94,+/- ,95,=,96,2nd Pause,EOF,EOF 30 DATA 22,GTO,23,LBL,28,2nd SBR,57, 2nd Fix,61,STO,71,RCL,81,EXC,EOF,EOF 40 DATA 61.45,STO y^x,61.55,STO :, 61.65,STO *,61.75,STO - ,61.85,STO +,EOF,EOF 45 DATA -26,2nd Inv x=t,- 27,2nd Inv x>=t,-28,2nd Inv SBR,- 29,2nd Inv Dsz,-31,Inv log,- 32,Inv lnx,-41,Inv DRG, -42,Inv sin,-43,Inv cos,-44,Inv tan,- 46,2nd Inv DRG>,-47,2nd Inv P<>R,- 48,2nd Inv DMS-DD,-52,Inv EE, -57,2nd Inv Fix,EOF,EOF 50 RESTORE:S$="" 60 L=LEN(L$):IF L<>2 AND L<>5 AND L<>8 AND L<>3 THEN S$="Erreur longu eur":NE=NE+1:GOTO 140 65 IF L=3 THEN RESTORE 45 70 IF L=5 THEN RESTORE 30 80 IF L=8 THEN RESTORE 40 85 IF L=2 AND VAL(L$)=>0 AND VAL(L$) <=9 THEN S$=RIGHT$(L$,1):GOTO 100 90 READ A$,B$:IF LEFT$(L$,2+3*ABS(L= 8)+1*ABS(L=3))=A$ THEN S$=S$+B$ ELSE IF A$<>"EOF" AND S$="" THEN GOTO 90 100 REM 110 IF (L=5 OR L=8) AND S$<>"" THEN S$=S$+" "+RIGHT$(L$,1):IF VAL(RIGH T$(L$,2))<0 OR VAL(RIGHT$(L$,2))>9 THEN S$="" 120 IF S$="" THEN S$="Erreur syntaxe ":NE=NE+1:GOTO 140 140 PRINT CHR$(12);L$;CSR(11);S$;CSR (26);C;CHR$(13);"Conversion....Erre ur:";NE; 150 RETURN ************************** Calendrier preptuel (c) Neibaf 1 REM (C) NEIBAF 10 CLS:PRINT "CALENDRIER PERPETUEL"; 20 DIM J$(7),M$(12),JO(12) 30 RESTORE 140:FOR I=0 TO 6:READ J$ (I):NEXT:FOR I=1 TO 12:READ M$(I),J O(I):NEXT 40 CLS:INPUT "Jour :",J:IF J<1 THEN 40 ELSE INPUT "Mois :",M:GOTO 160 50 INPUT "Annee :",A 60 CLS:PRINT "Le ";RIGHT$(STR$(J),2 );"/";RIGHT$(STR$(M),2);"/";MID$(ST R$(A),2,5)" correspond au";:PRINT :GOSUB 100 70 JS=FRAC((JD-1720977)/7) 80 JS=INT(7*(JS-INT(JS))+.001) 90 PRINT J$(JS);J;M$(M);A;:A$=INPUT $(1,@):IF A$=CHR$(13) THEN CLS:GOTO 40 ELSE CLS:ERASE M$,J$,M,A$:END 100 MAN=INT(.6+1/M+.001):MP=M+12*MA N:AP=A- MAN 110 JD=J+INT((367*(MP- 1)+5)/12+.001)+INT(365.25*(AP+471 2)+.001) 120 JD=JD-INT(AP/100)+INT(AP/400) 130 RETURN 140 DATA Dimanche,Lundi,Mardi,Mercr edi,Jeudi,Vendredi,Samedi 150 DATA Janvier,31,Fevrier,29,Mars ,31,Avril,30,Mai,31,Juin,30,Juillet ,31,Aout,31,Septembre,30,Octobre, 31,Novembre,30,Decembre,31 160 IF M>12 OR M<1 THEN CLS:BEEP:PR INT "Une annee compte 12 mois";:A$= INPUT$(1,@):GOTO 40 170 IF J>JO(M) OR J<1 THEN CLS:BEEP :PRINT "Il y a"JO(M)"jours en "M$(M );:A$=INPUT$(1,@):GOTO 40 180 GOTO 50 ************************** C'est tout pour l'instant, mais vous pouvez m'en envoyer l'adresse suivante: Saint-Cricq William 9 Cit Bel Air 65000 TARBES ATTENTION: CES PROGRAMMES NE PEUVENT ETRE VENDUS. ILS SONT DU DOMAINE PUBLIC ET SONT DISTRIBUES PAR W-TEL.